perm filename FILLER.SAI[OK,TES]2 blob
sn#115799 filedate 1974-08-15 generic text, type T, neo UTF8
00100 ENTRY TEXTLINE ;
00200 BEGIN "FILLER"
00300
00400 DEFINE TERNAL = "EXTERNAL" , PRELOAD = "COMMENT" ;
00500 REQUIRE "PUBDFS" SOURCE!FILE ;
00600 REQUIRE "PUBMAI" SOURCE!FILE ;
00700 BEGIN "INNER BLOCK"
00800 REQUIRE "PUBINR" SOURCE!FILE ;
00900 REQUIRE "PUBPRO" SOURCE!FILE ;
01000
01100 comment, the following EXTERNAL SIMPLE PROCEDUREs are INTERNAL in PARSER.SAI ;
01200
01300 EXTERNAL STRING SIMPLE PROCEDURE RD(INTEGER BRKTBL) ;
01400
01500 EXTERNAL RECURSIVE STRING PROCEDURE PASS ;
01600
01700 EXTERNAL RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD) ;
01800
01900 EXTERNAL STRING SIMPLE PROCEDURE VEVAL ;
02000
02100 EXTERNAL STRING SIMPLE PROCEDURE EVALV(STRING THISWD ; INTEGER IX, TYP) ;
02200
02300 EXTERNAL SIMPLE PROCEDURE SWITCHFONT(INTEGER WHICH) ; TES 11/15/73 ;
02400
02500 FORWARD RECURSIVE PROCEDURE BOUND(INTEGER KIND) ;
02600
02700 EXTERNAL SIMPLE INTEGER PROCEDURE RFONT(INTEGER F) ; TES 11/29/73 ;
00100 COMMENT T H E L I N E F I L L E R
00200
00300 These routines build a first pass output line in string OWL
00400 and then call the line placer (PLACELINE()) to place it in an area.
00500 OWL is kept lengthy enough to hold any first pass output line.
00600 That way, a line can be constructed by IDPB'ing (with APPEND())
00700 inside OWL instead of by numerous concatenations.
00800 Characters in OWL[1 TO OAKS] belong to the current line being
00900 built. However, some of these characters describe FONT changes or
01000 forward label references and others mark word breaks or CR to the
01100 left margin for superimposing. Thus, the line reaches only to
01200 column POSN (relative to the left edge of the area), and FAKE of
01300 these columns are not occupied but are only allocated for forward
01400 references. Furthermore, in FILL mode, the last permissible point
01500 after which the line can be broken by a CrLf is marked by four
01600 variables: BRKPT, BRKPOSN, BRKSPCS, and BRKFAKE, which contain the
01700 values of OAKS, POSN, and FAKE at that point, and the number of
01800 delible spaces right after that point. Though there is normally a
01900 WDBRK character at the breakpoint, there may be none if it is the
02000 first breakpoint on the line or if it was caused by a hyphen.
02100 TEXTLINE sets up the input stream for processing by PROCESS.
02200 PROCESS scans it up to a {, cr, or altmode, obeying all control
02300 characters and EMITting all regular characters. EMIT calls APPEND
02400 after checking for line overflow, etc. Spaces are PROCESSed
02500 differently -- instead of calling EMIT to APPEND them immediately,
02600 EMSPACES is called, which just counts up spaces in SPCS and handles
02700 COMPACTion and punctuation problems. Thus, when EMIT is called, it
02800 must append SPCS spaces before appending its argument. ;
02900
03000 SIMPLE PROCEDURE APPEND(STRING CHARS) ;
03100 IF ON THEN
03200 BEGIN "APPEND"
03300 STRING D ; INTEGER CCT, BALANCE ;
03400 DEFINE SRC="'15", COUNT="'14", DEST="'13", CHAR="'11" ;
03500 CCT ← LENGTH(CHARS) ;
03600 IF (BALANCE ← LENGTH(OWL) - (OAKS+CCT)) < 0 THEN
03700 OWL ← OWL & SPS((1-BALANCE)*2) ;
03800 IF CCT > 0 THEN
03900 BEGIN
04000 LABEL IUD ; COMMENT DEPOSIT LOOP ;
04100 D ← OWL[OAKS+1 FOR 1] ;
04200 START!CODE "APPD"
04300 MOVE SRC, CHARS ;
04400 HRRZ COUNT, CCT ;
04500 ADDM COUNT, OAKS ;
04600 MOVE DEST, D ;
04700 IUD: ILDB CHAR, SRC ;
04800 IDPB CHAR, DEST ;
04900 SOJG COUNT, IUD ;
05000 END "APPD"
05100 END ;
05200 END "APPEND" ;
00100 INTERNAL STRING SIMPLE PROCEDURE LABELREF(INTEGER USYMB, LEN) ;
00200 IF ¬ON THEN RETURN(NULL) ELSE
00300 BEGIN "LABELREF"
00400 INTEGER PTR, PLIGHT, WASSYMB ; STRING S ;
00500 IF NULSTR(THISWD) THEN ie, Generated Label for {PAGE}. USYMB=0.;
00600 PTR ← (PLBL ← PUTI(1, PLBL)) LOR TWO(14) ie Add to Linked List ;
00700 ELSE IF BYTEWD ← NUMBER[ PTR ← SYMNUM(THISWD & ":") ] THEN
00800 BEGIN "KNOWN LABEL"
00900 CASE (PLIGHT ← LDB(PLIGHTWD(BYTEWD))) MOD 3 OF
01000 BEGIN COMMENT BY PLIGHT ;
01100 ie 0 or 3 ... Page Label still Uncertain ; WASSYMB ← SYMPAGE ;
01200 ie 1 ... Referenced but not defined ; WASSYMB ← LDB(IXWD(BYTEWD)) ;
01300 ie 2 ... Defined and Certain ;
01400 BEGIN
01500 BREAKSET(LOCAL!TABLE,ALTMODE,"IS");
01600 BREAKSET(LOCAL!TABLE,NULL,"O");
01700 S ← STBL[LDB(IXWD(BYTEWD))] ;
01800 RETURN (SCAN(S,LOCAL!TABLE,DUMMY));
01900 END;
02000 END ; COMMENT BY PLIGHT ;
02100 IF USYMB AND LDB(IXN(USYMB)) ≠ LDB(IXN(WASSYMB)) THEN
02200 BEGIN "DIFFERENT UNIT"
02300 IF WASSYMB THEN WARN("X-REF ERROR","Label "&SYM[PTR]&
02400 " was cross-referenced as a "&SYM[WASSYMB]&
02500 " earlier, but now as a "&SYM[USYMB]) ;
02600 IF PLIGHT = 1 THEN NUMBER[PTR] ← 1 ROT -2 LOR USYMB ;
02700 END "DIFFERENT UNIT" ;
02800 END "KNOWN LABEL"
02900 ELSE NUMBER[PTR] ← 1 ROT -2 LOR USYMB ;
03000 RETURN(RUBOUT & CVS(LEN) & VT & CVS(PTR) & VT) ;
03100 END "LABELREF" ;
03200
03300 INTERNAL SIMPLE STRING PROCEDURE PICKFONT(INTEGER F) ; TES 11/15/73 11/29/73 ;
03400 RETURN(FONTCHAR&"F"&(IF F<10 THEN (F+"0") ELSE (F+("A"-10))));
00100 SIMPLE PROCEDURE OKSP(BOOLEAN EVEN!BEFORE!LMARG) ;
00200 IF LASTWDBRK ≠ OAKS AND ON AND
00300 JUSTIFY AND (POSN<MAXIM OR XCRIBL) AND (EVEN!BEFORE!LMARG OR POSN > 0 MAX INDENT) THEN
00400 BEGIN APPEND(WDBRK) ; LASTWDBRK ← OAKS ; END ;
00500
00600 SIMPLE PROCEDURE OKCR(BOOLEAN EVEN!IN!SUPERSUBSCRIPT) ;
00700 IF BRKPT≠OAKS AND ON AND (SUPERSUB=0 OR EVEN!IN!SUPERSUBSCRIPT) THEN
00800 BEGIN
00900 BRKPT ← OAKS ; BRKPOSN ← POSN ; BRKFAKE ← FAKE ; BRKPLBL ← PLBL ; BRKSPCS ← 0 ;
01000 BRKUNDER ← UNDERLINING ; TES 12/28/73 ;
01100 BRKFONT ← THISFONT ; TES 11/16/73 ;
01200 BRKXPOSN ← XPOSN - FSHORT ;
01300 IF SUPERSUB THEN RETURN ;
01400 BRKABX ← BRKABX MAX ABOVEX ; BRKBLX ← BRKBLX MIN BELOWX ; ABOVEX←BELOWX←0 ;
01500 END "OKCR" ;
01600
01700 INTERNAL INTEGER SIMPLE PROCEDURE XLENGTH(STRING CHARS);
01800 BEGIN "XL"
01900 INTEGER COUNT,CH,W;
02000 IF NOT XCRIBL THEN RETURN(0); COMMENT IF NOT IN XCRIBL MODE THEN WE DON'T NEED THIS VALUE;
02100 COUNT←0;
02200 WHILE FULSTR(CHARS) DO
02210 IFC VERSION = SAILVER OR VERSION = PARCVER THENC
02220 BEGIN TES 8/14/74, HOW ABOUT CMU & ITS ? ;
02230 IF 0 < (W← CW[ CH←LOP(CHARS) ]) AND W LEQ XMAXIM THEN
02240 COUNT ← COUNT + W
02250 ELSE WARN("BAD FONT CHAR", "THE CHARACTER '" & CVOS(CH) &
02260 " HAS AN UNUSUAL FONT WIDTH " & CVS(W) & CRLF &
02270 "DID YOU PERCHANCE FORGET TO DECLARE A FONT?") ;
02280 END ;
02290 ELSEC
02300 COUNT ← COUNT + CW[LOP(CHARS)];
02310 ENDC
02400 RETURN (COUNT);
02500 END;
02600
02700 INTEGER SIMPLE PROCEDURE XSPLEN(INTEGER N);
02800 RETURN(N * CW[SP]);
02900
03000 STRING SIMPLE PROCEDURE TRUNCATE(STRING STR; INTEGER LEN); RKJ: 1-5-74;
03100 BEGIN "TRUNCATE" COMMENT RETURN INITIAL SUBSTRING OF STR OF XLEN ≤ LEN ;
03200 STRING S; INTEGER I,L;
03300 S←STR; I←L←0;
03400 WHILE FULSTR(S) DO
03500 BEGIN
03600 IF (L←L+CW[LOP(S)])>LEN THEN RETURN(STR[1 TO I]);
03700 I←I+1;
03800 END;
03900 RETURN(STR);
04000 END "TRUNCATE";
04100
04200 RECURSIVE PROCEDURE EMITPIECE(STRING CHARS; INTEGER NCHARS, XCHARL) ;
04300 BEGIN TES PROCEDURIZED 11/29/73 ;
04400 INTEGER EXCHARS, WASBRC ; STRING EXCESS ; LABEL ADDIT ; comment Sorry about that ;
04500 INTEGER XSPCL,XEXCHARS; RKJ;
04600 XSPCL ← XSPLEN(SPCS) ; RKJ;
04700 RKJ: OLD LINE IF POSN + SPCS + NCHARS ≤ MAXIM THEN comment, no overfow ;
04800 IF (IF XCRIBL THEN (XPOSN+XSPCL+XCHARL≤XMAXIM) ELSE (POSN+SPCS+NCHARS≤MAXIM)) THEN comment no overflow;
04900 ADDIT:
05000 BEGIN
05100 IF SPCS AND XCRIBL AND (FILL AND ADJUST) AND POSN>INDENT THEN
05200 BEGIN FSHORT←FSHORT+XSPLEN(1); SPCS←SPCS-1 END;
05300 IF SPCS THEN BEGIN APPEND(SPS(SPCS)) ; BRKSPCS ← SPCS END ;
05400 APPEND(CHARS) ; POSN ← POSN + SPCS + NCHARS ; SPCS ← 0 ;
05500 XPOSN ← XPOSN + XSPCL + XCHARL; RKJ;
05600 END
05700 ELSE IF FILL AND (BRKPT>INDENT OR BRKPOSN>INDENT) THEN comment, go back to a break point ;
05800 BEGIN
05900 IF BRKPT=OAKS THEN BEGIN XSPCL ← SPCS ← EXCHARS ← 0 ; EXCESS ← NULL END
06000 ELSE BEGIN EXCESS←OWL[BRKPT+1+BRKSPCS TO OAKS]; COPY(EXCESS);
06100 XEXCHARS ← XPOSN-FSHORT-BRKXPOSN-BRKSPCS*XSPLEN(1);
06200 EXCHARS←POSN-BRKPOSN-BRKSPCS END;
06300 FAKE ← FAKE - BRKFAKE ; NOPGPH ← -1 ; WASBRC ← BRC ;
06400 OAKS ← BRKPT ; BOUND(3) ; COMMENT ADDED 4/14/72 ;
06500 PLACELINE(IF OWL[OAKS FOR 1]=WDBRK ∧ LASTWDBRK=OAKS COMMENT JAN 9 73 ;
06600 THEN OAKS-1 ELSE OAKS, BRKPOSN MIN MAXIM, BRKXPOSN,
06700 BRKFAKE, BRKABX, -BRKBLX, IF FIRST THEN LEADFM ELSE SPREADM-1,
06800 BRKPLBL, ADJUST, SPREADM) ;
06900 FSHORT ← NOPGPH ← OAKS ← TABI ← BRKABX ← BRKBLX ← STARPOSN ← AMPPOSN ← LASTWDBRK ← 0 ; BRC←WASBRC;
07000 COMMENT VARIABLES NEEDED BEYOND THE ABOVE "PLACELINE"
07100 HAD BETTER BE "MIDWDS" IN PUBDFS.SAI ;
07200 IF FIRST THEN BEGIN
07300 INDENT ← RESTIM MAX -LMARG ; FIRST ← FALSE ;
07400 END ;
07500 IF XCRIBL
07600 THEN
07700 BEGIN
07800 APPEND(PICKFONT(BRKFONT)) ; BRKFONT ← THISFONT ; TES 11/16/73 ;
07900 IF (LMARG+INDENT)≠0 THEN APPEND(FONTCHAR&"="&CVSR("CHARW*(LMARG+INDENT)"));
08000 XPOSN←CHARW*INDENT;
08100 END
08200 ELSE
08300 BEGIN
08400 APPEND(SPS(LMARG+INDENT));
08500 END;
08600 POSN←INDENT;
08700 IF BRKUNDER THEN BEGIN APPEND(FONTCHAR&"_"); BRKUNDER ← 0 END ; TES 12/28/73;
08800 OKCR(TRUE); TES MOVED AFTER BRKUNDER TEST, 12/28/73 ;
08900 APPEND(EXCESS);
09000 POSN←POSN+EXCHARS; XPOSN←XPOSN+XEXCHARS;
09100 IF SPCS THEN BEGIN OKSP(FALSE) ; OKCR(FALSE) END ;
09200 GO TO ADDIT ;
09300 END
09400 ELSE IF (IF XCRIBL THEN XPOSN≤XMAXIM ELSE POSN≤MAXIM)
09500 THEN comment, About to overflow right edge of area! ;
09600 BEGIN "LINE TOO LONG"
09700 STRING S; RKJ: 1-5-74;
09800 S←SPS(SPCS)&CHARS; RKJ: 1-5-74;
09900 APPEND((IF XCRIBL THEN (EXCESS←TRUNCATE(S,XMAXIM-XPOSN)) ELSE S[1 TO MAXIM - POSN])) ;
10000 IF XCRIBL AND FONTFIL[DEFAULTFONT]=0 THEN TES 11/15/73;
10100 WARN("=", "FONT declaration needed. Start over!")
10200 ELSE
10300 WARN("Line too long","Line too long -- characters lost:" &
10400 S[(IF XCRIBL THEN LENGTH(EXCESS)+1 ELSE MAXIM-POSN+1) TO ∞] & "...") ;
10500 POSN ← MAXIM+1 ; SPCS ← 0 ;
10600 XPOSN ← XMAXIM + 1; RKJ;
10700 END ;
10800 MIDWORD ← MIDWORD OR FULSTR(CHARS) ; PUNC ← FALSE ;
10900 END "EMITPIECE" ;
11000
11100 RECURSIVE PROCEDURE EMIT(STRING CHARS) ;
11200 IF ON THEN EMITPIECE(CHARS, LENGTH(CHARS), XLENGTH(CHARS)) ;
00100 INTEGER XLBFAKE; RKJ: FOR FORWARD REFERENCES IN BOUNDED ITEMS ;
00200 RECURSIVE PROCEDURE BOUND(INTEGER KIND) ;
00300 IF ON THEN
00400 BEGIN
00500 INTEGER LB, RB, DEST, FILLIN, XLB, XFILLIN ;
00600 INTEGER INFLB, INFRB ; RKJ: 1-8-74;
00700 LABEL SLIDEFILL, TABFILL, TABCASE ; STRING FILLER, BOUNDS ;
00800 STRING SEGMENT ;
00900 COMMENT KIND ≤ 0 ... ∞X (The ASCII of X negated)
01000 = 1 ... ←
01100 = 2 ... →
01200 = 3 ... CR or BREAK
01300 = 4 ... Tab (\ or ∂) ;
01400 IF KIND=3 OR KIND=4 AND NULSTR(LBF) THEN SPCS ← 0 ELSE EMIT(NULL) ;
01500 OKCR(TRUE) ; comment added 4/17/72 ;
01600 Comment An earlier BOUND on this line may have set LBK←KIND ;
01700 IF LBK < 3 THEN CASE LBK MAX 0 OF
01800 BEGIN COMMENT BY KIND ;
01900 ie ≤ 0 ... ∞ Only valid if immediately preceding this Bound ;
02000 IF LBO < OAKS ∨ SPCS THEN
02100 BEGIN
02200 WARN("=","∞ needs a right bound") ;
02300 LBF ← NULL ;
02400 END ;
02500 ie = 1 ... ← Center between left bound at POSN=LBP and this TAB to RBOUND, or between margins ;
02600 BEGIN "CENTER"
02700 IF KIND=4 THEN BEGIN XLB←XLBP ; LB←LBP ; RB←RBOUND END
02800 ELSE BEGIN LB←XLB←0 ; RB←RMARG-LMARG END ;
02900 BOUNDS ← CVSR("INFRB←(LMARG+RB)*(IF XCRIBL THEN CHARW ELSE 1)") & CVSR("INFLB←(LMARG+LBP-LB)*(IF XCRIBL THEN CHARW ELSE 1)");
03000 FILLIN ← ((RB - POSN) - (LBP - LB)) DIV 2 ; COMMENT UPPER BOUND ESTIMATE ;
03100 SLIDEFILL:
03200 XFILLIN ← XPOSN - XLBP -(FAKE-XLBFAKE) ; COMMENT LENGTH OF PIECE ;
03300 SEGMENT ← OWL[LBO+1 TO OAKS] ; COPY(SEGMENT) ; OAKS ← LBO ; FILLER ← OLBF ;
03400 TABFILL:
03500 APPEND(FONTCHAR & "→") ; APPEND(BOUNDS) ;
03600 IF XCRIBL THEN
03700 BEGIN
03800 RKJ ; APPEND(CVSR(XFILLIN)) ;
03900 RKJ: 1-8-74 MODIFIED XGP INFINITY ; RKJ: 1-22-74 again, always need new XFILLIN ;
04000 IF INFLB<-900 THEN COMMENT FLUSH RIGHT ;
04100 XFILLIN←INFRB-XFILLIN-XLBP-(FAKE-XLBFAKE)
04200 ELSE COMMENT CENTER ;
04300 XFILLIN←(INFRB-INFLB-XFILLIN-(FAKE-XLBFAKE)) DIV 2 ;
04400 IF NULSTR(FILLER) THEN APPEND(CVSR(0)) ELSE
04500 APPEND(CVSR("XFILLIN DIV XLENGTH(FILLER)"));
04600 TES trying 5-26-74 RKJ's above instead of my APPEND(CVSR("(FILLIN*CHARW)/XLENGTH(FILLER)")) ;
04700 END ;
04800 APPEND(FILLER & ALTMODE) ;
04900 APPEND(SEGMENT) ; APPEND(FONTCHAR & "←") ;
05000 POSN ← POSN + (FILLIN MAX 0) ;
05100 XPOSN ← XPOSN + (XFILLIN MAX 0) ;
05200 END "CENTER" ;
05300 ie 2 ... → Right flush against TAB to RBOUND or against right margin ;
05400 BEGIN "RIGHT FLUSH"
05500 RB ← IF KIND=4 THEN RBOUND ELSE RMARG-LMARG ;
05600 FILLIN ← RB - POSN ;
05700 BOUNDS ← CVSR("INFRB←(LMARG+RB)*(IF XCRIBL THEN CHARW ELSE 1)") & CVSR("INFLB←(IF XCRIBL THEN (-CHARW*1000) ELSE -1000)") ;
05800 GO TO SLIDEFILL ;
05900 END "RIGHT FLUSH" ;
06000 END ; COMMENT BY KIND ;
06100 IF KIND=3 ∧ FULSTR(LBF) THEN BEGIN RBOUND ← RMARG ; GO TO TABCASE END ;
06200 IF KIND=4 THEN
06300 BEGIN "TAB"
06400 IF FULSTR(LBF) THEN
06500 TABCASE: BEGIN
06600 FILLIN ← RBOUND - POSN ; BOUNDS ← CVSR(LMARG+RBOUND) & CVSR(-1000) ;
06700 XFILLIN←XPOSN-XLBP; RKJ: 1-22-74 ;
06800 BOUNDS ← CVSR("INFRB←(LMARG+RBOUND)*(IF XCRIBL THEN CHARW ELSE 1)") &
06900 CVSR("INFLB←(IF XCRIBL THEN (-CHARW*1000) ELSE -1000)") ;
07000 RKJ: 1-21-74 copied above two lines, overlooked earlier ;
07100 FILLER ← LBF ; SEGMENT ← NULL ; KIND ← KIND + 2 ; GO TO TABFILL ;
07200 END
07300 ELSE APPEND(FONTCHAR&"="&CVSR("IF XCRIBL THEN CHARW*(RBOUND+LMARG) ELSE RBOUND+LMARG"));
07400 BRKXPOSN←BRKXPOSN+FSHORT; FSHORT←0;
07500 POSN ← RBOUND ; XPOSN ← RBOUND * CHARW ;
07600 END "TAB" ;
07700 IF KIND > 4 THEN KIND ← KIND - 2 ; COMMENT CORRECTS `KIND←KIND+2' ABOVE ↑↑↑↑↑↑↑ ;
07800 IF KIND = 4 AND POSN > MAXIM THEN MAXIM ← NMAXIM+LMARG
07900 ELSE IF FILL THEN MAXIM ← IF KIND ≤ 2 THEN NMAXIM ELSE FMAXIM ;
08000 IF KIND = 3 THEN XLBP ← LBP ← LBO ← 0 RKJ: 1-22-74; ELSE
08100 BEGIN
08200 comment Finally, set Left Bound for a subsequent BOUND ;
08300 LBO ← OAKS ; LBP ← POSN ; XLBP ← XPOSN ; LBK ← KIND ; MIDWORD ← FALSE ;
08400 XLBFAKE ← FAKE ;
08500 CASE ((KIND+1) MAX 0) DIV 2 OF BEGIN LBF←LBF&(-KIND) ; BEGIN OLBF←LBF ; LBF←NULL END ; OLBF←LBF←NULL END ;
08600 END ;
08700 END "BOUND" ;
00100 INTERNAL RECURSIVE PROCEDURE DBREAK ;
00200 IF ON THEN IF NOPGPH THEN NOPGPH ← -1 ELSE
00300 BEGIN INTEGER STTS ;
00400 NOPGPH ← -1 ;
00500 BOUND(3) ;
00600 IF POSN > INDENT OR VERBATIM THEN
00700 BEGIN "A PGPH"
00800 PLACELINE(IF LASTWDBRK=OAKS THEN OAKS-1 ELSE OAKS, POSN MIN MAXIM, XMAXIM-FSHORT,
00900 FAKE, ABOVEX MAX BRKABX,
01000 -(BELOWX MIN BRKBLX),
01100 IF NOFILL THEN LEADNM ELSE IF FIRST THEN LEADFM ELSE SPREADM-1,
01200 PLBL, IF XCRIBL AND ADJUST THEN TRUE ELSE JUSTJUST, 0) ;
01300 FSHORT ← SINCELFM ← 0 ;
01400 IF ENDCASE=2 THEN BEGIN STTS←STARTS; IF ENDBLOCK THEN WARN("=","Missed END in Response|Footnote");
01500 STARTS ← STARTS + STTS ; END ;
01600 END "A PGPH" ;
01700 END "DBREAK" ;
01800
01900 SIMPLE PROCEDURE EMSPACES(INTEGER N) ;
02000 IF ON THEN BEGIN
02100 IF SPCS=0 THEN BEGIN OKSP(FALSE) ; OKCR(FALSE) END ; MIDWORD ← FALSE ;
02200 SPCS ← IF COMPACT THEN (SPCS+N) MIN (IF PUNC THEN 2 ELSE 1) ELSE SPCS+N ;
02300 END "EMSPACES" ;
02400
02500 RECURSIVE PROCEDURE TABTO(INTEGER POSNO) ;
02600 IF ON THEN
02610 BEGIN TES 8/14/74 SIMPLIFIED AND FIXED A BUG ;
02700 IF (IF XCRIBL THEN (POSNO*CHARW ≤ XPOSN) ELSE (POSNO≤POSN)) THEN
02710 IF FULSTR(LBF) THEN
02800 BEGIN
02810 WARN("=","Already passed tab column " & CVS(POSNO)) ;
02815 RETURN ;
02817 END
02820 ELSE TABI ← 0
02900 ELSE IF POSNO>NMAXIM+LMARG THEN
02910 BEGIN
03000 WARN("=","No such tab column "&(IF POSNO>TWO(15) THEN NULL ELSE CVS(POSNO))) ;
03010 RETURN
03020 END ;
03300 RBOUND ← POSNO-1 ;
03400 BOUND(4) ;
04000 END "TABTO" ;
04100
04200 RECURSIVE BOOLEAN PROCEDURE ATLEAD(INTEGER LEADSPACES) ;
04300 BEGIN
04400 IF FINDINSET(LEADSPACES) AND FULSTR("SSTK[BODY(LLTHIS)]")THEN RESPOND(LLTHIS)
04500 ELSE RETURN(FALSE) ;
04600 RETURN(TRUE) ;
04700 END "ATLEAD" ;
04800
04900 BOOLEAN SIMPLE PROCEDURE SIGNA(INTEGER SIGCH1) ;
05000 BEGIN
05100 INTEGER ARG, RIX, ARGS, SEPS ; STRING SEE ;
05200 SEE ← SIGCH1 & INPUTSTR ;
05300 LLSCAN(SIGNALD[SIGCH1], NEXT!RESP, "CVASC(SEE[1 FOR CLUE(LLTHIS)])=SIGNAL(LLTHIS)") ;
05400 IF LLTHIS = 0 THEN RETURN(FALSE) ; RIX ← LLTHIS ; ARGS ← NUMARGS(RIX) ;
05500 INPUTSTR ← INPUTSTR[CLUE(RIX) TO ∞] ;
05600 IF ARGS THEN BEGIN "SCAN ARGS"
05700 SEPS ← RESP!SEP(RIX) ; IF LAST + ARGS > SIZE THEN GROWNESTS ;
05800 FOR ARG ← 1 THRU ARGS DO
05900 BEGIN "SEPBREAK"
06000 SETBREAK(LOCAL!TABLE,
06100 (SEPS LSH ((ARG-ARGS)*7) LAND '177) & CRLF, NULL, "IS") ;
06200 SEE ← NULL ;
06300 DO BEGIN
06400 SEE ← SEE & RD(LOCAL!TABLE) ;
06500 IF BRC = CR THEN
06600 BEGIN
06700 IF FULSTR("RD(TO!NON!SP)") ∨ BRC≠RCBRAK
06800 ∨ INPUTSTR[2 FOR 1]≠VT THEN DONE ;
06900 LOPP(INPUTSTR) ; LOPP(INPUTSTR) ; IF FULSTR(SEE) THEN SEE ← SEE & SP ;
07000 END
07100 ELSE BRC ← -1 ;
07200 END UNTIL BRC < 0 ;
07300 SNEST[LAST + ARG] ← SEE ;
07400 IF BRC > 0 THEN
07500 BEGIN
07600 WARN("=","Missing Signal Separator") ;
07700 FOR ARG ← ARG+1 THRU ARGS DO SNEST[LAST+ARG] ← NULL ;
07800 END ;
07900 END "SEPBREAK" ;
08000 IF ON THEN LAST ← LAST + ARGS ; COMMENT "IF" JAN 9 1973 ;
08100 END "SCAN ARGS" ;
08200 RESPOND(RIX) ; RETURN(TRUE) ;
08300 END "SIGNA" ;
08400
08500 SIMPLE STRING PROCEDURE MASH(STRING S) ;
08600 BEGIN COMMENT TES 8/14/74 UNPACK 7-BIT BYES TO 64-EXCESS 4-BIT BYTES;
08700 INTEGER C ; STRING Q ;
08800 Q ← NULL ;
08900 WHILE FULSTR(S) DO
09000 BEGIN
09100 C ← LOP(S) ;
09200 Q ← Q & ((C LSH -4)+64) & ((C LAND '17)+64) ;
09300 END ;
09400 RETURN(Q) ;
09500 END ;
00100 SIMPLE PROCEDURE UNSCRIPT(INTEGER ARROW) ;
00200 BEGIN
00300 INTEGER CHR, PN ; BOOLEAN MORE, WILLRIPT ;
00400 IF ARROW = 0 THEN
00500 BEGIN COMMENT "]" -- find matching "[" ;
00600 ARROW ← SUPERSUB LAND '177 ;
00700 AMPPOSN ← AMPPOSN LSH -9 ; COMMENT 3/28/72 ;
00800 SUPERSUB ← SUPERSUB LSH -9 ;
00900 END ;
01000 IF POSN ≤ MAXIM OR XCRIBL THEN
01100 BEGIN
01200 EMIT(NULL) ;
01300 IF ARROW ≠ "." THEN
01400 BEGIN
01500 APPEND(FONTCHAR & ("↑"+"↓" - ARROW)) ;
01600 HEIGHT ← HEIGHT - (IF ARROW="↑" THEN 1 ELSE -1) ;
01700 END ;
01800 END ;
01900 WILLRIPT ← TRUE ; comment assume that RIPTPOSNS will be updated by SCRIPT if necessary ;
02000 IF LDB(SPCODE(INPUTSTR)) = AMSAND THEN
02100 BEGIN
02200 LOPP(INPUTSTR) ;
02300 MORE ← TRUE ; PN ← RIPTPOSNS LAND '177 - LMARG ; COMMENT 3/28/72: ;
02400 AMPPOSN ← ((AMPPOSN LSH -9) LSH 9) LOR ((AMPPOSN LAND '177) MAX POSN) ;
02500 IF PN<POSN THEN BEGIN APPEND(FONTCHAR&"-"&CVSR(POSN-PN)) ; POSN←PN END ;
02600 IF (CHR ← LDB(SPCODE(INPUTSTR))) = LBRACK THEN
02700 BEGIN
02800 SUPERSUB ← SUPERSUB LSH 9 LOR "." ;
02900 LOPP(INPUTSTR) ; WILLRIPT ← FALSE ; comment not a ript: won't call SCRIPT! ;
03000 END
03100 ELSE IF CHR≠UARROW AND CHR≠DARROW THEN BEGIN EMIT(LOP(INPUTSTR)) ; MORE ← FALSE END ;
03200 END
03300 ELSE MORE ← FALSE ;
03400 IF ¬MORE THEN BEGIN COMMENT 3/28/72: ;
03500 PN ← (AMPPOSN LAND '177) MAX POSN ; AMPPOSN ← (AMPPOSN LSH -9) LSH 9 ;
03600 IF PN>POSN THEN BEGIN APPEND(FONTCHAR&"+"&CVSR(PN-POSN)) ; POSN←PN END END ;
03700 IF WILLRIPT THEN RIPTPOSNS ← RIPTPOSNS LSH -9 ;
03800 END "UNSCRIPT" ;
03900
04000 SIMPLE PROCEDURE SCRIPT(INTEGER ARROW) ;
04100 BEGIN
04200 INTEGER CHR ;
04300 CHR ← LOP(INPUTSTR) ;
04400 HEIGHT ← HEIGHT + (IF ARROW="↑" THEN 1 ELSE -1) ;
04500 ABOVEX ← ABOVEX MAX HEIGHT ; BELOWX ← BELOWX MIN HEIGHT ;
04600 IF POSN ≤ MAXIM OR XCRIBL THEN BEGIN EMIT(NULL) ; APPEND(FONTCHAR&ARROW) ; END ;
04700 RIPTPOSNS ← RIPTPOSNS LSH 9 LOR (POSN+LMARG) ;
04800 IF LDB(SPCODE(CHR))=LBRACK THEN BEGIN SUPERSUB ← SUPERSUB LSH 9 LOR ARROW ;
04900 AMPPOSN ← AMPPOSN LSH 9 ; COMMENT 3/28/72 ; END
05000 ELSE BEGIN EMIT(CHR) ; UNSCRIPT(ARROW) END ;
05100 END "SCRIPT" ;
00100 RECURSIVE PROCEDURE PROCESS ;
00200 BEGIN
00300 INTEGER N, CHR, F, INSET ; BOOLEAN PLUS, DONE ; STRING PIECE ; LABEL ENDERLINE ;
00400 EMPTYTHIS ; INSET ← 0 ;
00500 IF INPUTSTR = VT THEN IF ¬ON THEN LOPP(INPUTSTR) ELSE
00600 BEGIN "NEW INPUT LINE"
00700 LOPP(INPUTSTR) ;
00800 IF VERBATIM THEN BEGIN END
00900 ELSE IF INPUTSTR=CR ∧ (N←SIGNALD[CR]) THEN BEGIN LOPP(INPUTSTR) ; RESPOND(N) ; RETURN END
01000 ELSE IF ATLEAD(INSET ← LENGTH(RD(TO!NON!SP))) THEN INSET←0 ; comment AT NULL , AT <integer> ;
01100 END "NEW INPUT LINE" ;
01200 IF NOPGPH ∧ ON THEN ie, First line of paragraph ;
01300 BEGIN "START PARAGRAPH"
01400 OAKS←SPCS←TABI←PUNC←MIDWORD←SUPERSUB←ABOVEX←BELOWX←HEIGHT←FAKE←BRKABX←BRKBLX←UNDERLINING←0 ;
01500 FIRST ← NOFILL ∨ NOPGPH<0 ; STARPOSN←AMPPOSN←LASTWDBRK←0 ;
01600 BRKFONT ← THISFONT ; TES 11/16/73 ; BRKUNDER ← 0 ; TES 12/28/73 ;
01700 INDENT ← IF FLUSHL∨VERBATIM∨CENTER∨FLUSHR THEN 0
01800 ELSE (IF NOFILL OR FIRST THEN FIRSTIM ELSE RESTIM) MAX -LMARG ;
01900 NOPGPH ← 0 ; LBK ← 3 ; LBF ← NULL ;
02000 IF XCRIBL
02100 THEN
02200 BEGIN
02300 APPEND(PICKFONT(THISFONT)) ; TES 11/15/73 ;
02400 IF (LMARG+INDENT)≠0 THEN APPEND(FONTCHAR&"="&CVSR("CHARW*(LMARG+INDENT)"));
02500 XPOSN←CHARW*INDENT;
02600 END
02700 ELSE
02800 BEGIN
02900 APPEND(SPS(LMARG+INDENT));
03000 END;
03100 POSN←INDENT; FSHORT←0; OKCR(TRUE);
03200 IF FLUSHR THEN BOUND(2) ELSE IF CENTER THEN BOUND(1) ;
03300 FMAXIM ← (RMARG-RIGHTIM)-LMARG ;
03400 NMAXIM ← COLWID(IF AREAIXM THEN AREAIXM ELSE IXTEXT) - LMARG ;
03500 MAXIM ← IF FILL THEN FMAXIM ELSE NMAXIM ;
03600 IF VERBATIM THEN BEGIN JUSTIFY←FALSE; EMIT(RD(TO!CR!SKIP)); DBREAK ; RETURN END ;
03700 END "START PARAGRAPH" ;
03800 JUSTIFY ← FILL∧ADJUST ∨ JUSTJUST ; DONE ← FALSE ; IF INSET∧RETAIN∧¬FLUSHL THEN EMSPACES(INSET) ;
03900 DO BEGIN "SCAN TEXT"
04000 IF FULSTR("PIECE ← RD(TEXT!TBL)") THEN EMIT(PIECE) ;
04100 IF BRC≠CR ∧ SIGNALD[BRC] ∧ SIGNA(BRC) THEN BEGIN COMMENT Responded to signal ; END
04200 ELSE CASE CHARTBL[BRC] LAND '77 OF
04300 BEGIN COMMENT BY BRC ;
04400 ie 0 ; EMIT(BRC) ;
04500 ie 1 ... CR ; BEGIN SUPERSUB←HEIGHT←AMPPOSN←RIPTPOSNS←0 ;
04600 IF FILL ∧ CRSPACE THEN EMSPACES(IF SPCS ∨ ¬POSN THEN 0 ELSE IF PUNC THEN 2 ELSE 1)
04700 ELSE IF IMPOSE THEN
04800 BEGIN "SUPERIMPOSE"
04900 IF (N ← SINCELFM+1) > TWEENLFM THEN DBREAK
05000 ELSE BEGIN EMIT(NULL); APPEND(CR & SPS(LMARG+(POSN←INDENT))); SINCELFM ← N ;
05100 TABI←MIDWORD←STARPOSN←FAKE←0 ; LBK←3; LBF←NULL; OKCR(FALSE) END ;
05200 END "SUPERIMPOSE"
05300 ELSE DBREAK ;
05400 DONE ← TRUE ;
05500 END ;
05600 ie 2 ... Altmode or { ; DONE ← TRUE ;
05700 ie 3 ... Rubout;IF ON THEN
05800 BEGIN "LABEL REF"
05900 N ← CVD(SCAN(INPUTSTR,TO!VT!SKIP,F)) ;
06000 IF XCRIBL THEN
06100 BEGIN
06200 EMIT(S←"01234567890123456789012345678901234567890123456789"[1 FOR N]);
06300 FAKE←FAKE+XLENGTH(S);
06400 END
06500 ELSE
06600 BEGIN
06700 EMIT(SPS(N)); FAKE←FAKE+N;
06800 END;
06900 OAKS←OAKS-N;
07000 APPEND(VT&SCAN(INPUTSTR, TO!VT!SKIP, F)&ALTMODE) ;
07100 END "LABEL REF"
07200 ELSE FOR N ← 1,2 DO SCAN(INPUTSTR, TO!VT!SKIP, F) ;
07300 ie 4 ... α ; IF INPUTSTR≠ALTMODE THEN IF (N←LOP(INPUTSTR))=CR THEN DONE←TRUE
07400 ELSE BEGIN "CHKXGP"
07500 IF XCRIBL THEN
07600 IF (F←LDB(SPCODE(N))) = XCMDCHR
07700 THEN BEGIN EMIT(N); APPEND(N) END
07800 ELSE EMIT(N)
07900 ELSE EMIT(N);
08000 END "CHKXGP";
08100 ie 5 ... ↑C ; IF FILL THEN OKCR(FALSE) ELSE EMIT(BRC) ;
08200 ie 6 ... # ; EMIT(SP) ;
00100 ie 7 ... \ ; IF ON THEN BEGIN "NEXT TAB"
00200 POSN←POSN+SPCS; XPOSN←XPOSN+XSPLEN(SPCS); SPCS←0;
00300 DO BEGIN TABI←TABI+1; N←TABSORT[TABI] END
00400 UNTIL (IF XCRIBL THEN N*CHARW>XPOSN ELSE N>POSN);
00500 TABTO(N) ; IF N > NMAXIM+LMARG THEN TABI ← TABI - 1 ;
00600 END "NEXT TAB" ;
00700 ie 8 ... ∂ ; IF (CHR←INPUTSTR)=CR ∨ CHR=ALTMODE ∨ NULSTR(INPUTSTR) THEN EMIT(BRC)
00800 ELSE BEGIN "SPECIFIC TAB"
00900 SPCS←0 ;
01000 CHR ← LOP(INPUTSTR) ;
01100 IF (PLUS ← CHR)="+" ∨ CHR="-" THEN CHR ← LOP(INPUTSTR) ELSE PLUS←0 ;
01200 IF CHR="(" THEN
01300 BEGIN
01400 PASS ; N ← CVD(E("0",0)) ;
01500 IF ¬ITSCH(")") THEN WARN("=","Missed ) after ∂(...") ;
01600 END
01700 ELSE IF (F←LDB(FAMILY(CHR)))=0 THEN N←
01800 CVD(EVALV(SYM[N←SYMNUM(CHR)], LDB(IXN(N)), LDB(TYPEN(N))))
01900 ELSE IF F = DIGQ THEN N ← CHR - 48 comment, Digit ;
02000 ELSE BEGIN WARN("=","Unintelligible ∂ Construct") ; N ← 0 END ;
02100 IF PLUS="-" THEN
02200 BEGIN "BACKSPACE"
02300 EMIT(NULL) ; STARPOSN ← POSN MAX STARPOSN ;
02400 IF XCRIBL THEN
02500 BEGIN
02600 APPEND(FONTCHAR&'35&LOP(INPUTSTR));
02700 IF N ≠ 1 THEN
02800 WARN("=","Can't backspace more than one!!");
02900 END
03000 ELSE
03100 BEGIN
03200 POSN ← POSN-N MAX 0 ;
03300 APPEND(FONTCHAR&PLUS&CVSR(N)) ;
03400 END;
03500 END
03600 ELSE IF PLUS="+" ∧ NULSTR(LBF) THEN
03700 BEGIN
03800 IF N>0 THEN BEGIN APPEND(FONTCHAR&"+"&CVSR(IF XCRIBL THEN N*CHARW ELSE N));
03900 POSN←POSN+N MIN NMAXIM+LMARG END;
04000 END
04100 ELSE TABTO((IF PLUS="*" THEN STARPOSN ELSE
04200 IF PLUS="+" THEN POSN+N ELSE N) MIN NMAXIM+LMARG) ;
04300 END "SPECIFIC TAB" ;
04400 ie 9 ... ← ; IF LBK ≠ 2 THEN BOUND(1) ELSE EMIT(BRC) ;
04500 ie 10 ... → ; IF LBK ≠ 2 THEN BOUND(2) ELSE EMIT(BRC) ;
04600 ie 11 ... ∞ ; IF (N←INPUTSTR)=CR ∨ N=ALTMODE THEN WARN("=","∞ What?")
04700 ELSE BOUND(-LOP(INPUTSTR)) ;
04800 ie 12 ... ↑ ; IF ON ∧ (CHR←INPUTSTR)≠CR ∧ CHR≠ALTMODE THEN SCRIPT("↑") ELSE EMIT(BRC) ;
04900 ie 13 ... ↓ ; IF ON THEN IF (CHR←INPUTSTR)=CR ∨ CHR=ALTMODE THEN EMIT(BRC)
05000 ELSE IF LDB(SPCODE(INPUTSTR))=UNDERBAR THEN
05100 BEGIN
05200 LOPP(INPUTSTR) ; EMIT(NULL) ;
05300 IF POSN≤MAXIM OR XCRIBL THEN BEGIN IF UNDERLINING=0 THEN APPEND(FONTCHAR&"_"); UNDERLINING←2 END ;
05400 END
05500 ELSE SCRIPT("↓") ;
05600 ie 14 ... ] ; IF SUPERSUB AND ON THEN UNSCRIPT(0)
05700 ELSE EMIT(BRC) ;
00100 ie 15 ... hyphen ; IF MIDWORD AND FILL AND ON AND ¬SUPERSUB THEN
00200 BEGIN
00300 EMIT("-") ; OKCR(FALSE) ;
00400 IF INPUTSTR=CR THEN BEGIN LOPP(INPUTSTR); DONE←TRUE END ;
00500 END
00600 ELSE BEGIN N←MIDWORD ; EMIT(BRC) ; MIDWORD ← N END ;
00700 ie 16 ... .!? ; IF MIDWORD∧FILL∧ON∧¬SUPERSUB THEN BEGIN EMIT(BRC) ; PUNC←TRUE END
00800 ELSE EMIT(BRC) ;
00900 ie 17 ... space ; EMSPACES(1 + LENGTH(RD(TO!NON!SP)) ) ;
01000 ie 18 ... underline ; IF LDB(SPCODE(INPUTSTR))=DARROW AND ON THEN
01100 BEGIN
01200 LOPP(INPUTSTR) ; EMIT(NULL) ;
01300 IF UNDERLINING THEN
01400 ENDERLINE: BEGIN
01500 UNDERLINING ← 0 ;
01600 IF POSN≤MAXIM OR XCRIBL THEN APPEND(FONTCHAR&"≡") ;
01700 END ;
01800 END
01900 ELSE BEGIN
02000 EMIT(NULL) ;
02100 IF POSN≤MAXIM OR XCRIBL THEN
02200 EMIT(IF NULSTR(VUNDERLINE) THEN " " ELSE VUNDERLINE);
02300 COMMENT POSN< CHANGED TO POSN≤ ON 2/27/73 TES ;
02400 COMMENT EMIT(BRC) CHANGED TO USE VUNDERLINE 11/29/73 TES ;
02500 END ;
02600 ie 19 ... π ; TES 11/29/73 ;
03900 IF FULSTR(PIECE←PICHAR[CHR←INPUTSTR]) THEN
04000 BEGIN
04100 F ← LOP(PIECE) ; N ← LOP(PIECE) ;
04150 PIECE ← MASH(PIECE) ; TES 8/14/74 ;
04200 IF ON THEN
04300 EMITPIECE(FONTCHAR & "π" & LENGTH(PIECE) & PIECE,
04400 1,
04500 IF NOT XCRIBL THEN 0
04600 ELSE IF F='177 THEN CW[N]
04700 ELSE 128*F+N) ;
04800 LOPP(INPUTSTR) ;
04900 END
05000 ELSE EMIT(BRC) ;
05200 ie 20 ... ∪ ; IF ON ∧ UNDERLINING=0 THEN
05300 BEGIN COMMENT ∪NDERLINE ONE WORD ;
05400 EMIT(NULL) ; UNDERLINING ← 1 ;
05500 IF POSN<MAXIM OR XCRIBL THEN APPEND(FONTCHAR & "_") ;
05600 IF FULSTR("PIECE←RD(ALPHA)") THEN EMIT(PIECE) ;
05700 GO TO ENDERLINE ;
05800 END ;
05900 ie 21 ... ∩ ; EMIT(BRC) ; COMMENT CURRENTLY NOT USED ;
06000 ie 22 ... VT ; WARN("=", "`⊃' (TEMPLATE END) SEEMS TO BE ON TEXT LINE; SEE RULE(1) ON P.24 OF MANUAL") ;
06100 ie 23 ... $ ; IF LDB(SPCODE(INPUTSTR))=LBRACK THEN
06200 BEGIN LOPP(INPUTSTR) ; DONE←TRUE END ELSE EMIT(BRC) ; TES REM ERROR 6/11/74;
06300 ie 24 ... % ; IF ON THEN
06400 BEGIN "PERCENT"
06500 CHR←LOP(INPUTSTR);
06600 IF CHR="*" THEN F←OLDFONT
06700 ELSE IF (F ← RFONT(CHR)) < 0 THEN TES 11/29/73 RFONT;
06800 BEGIN WARN("=","Illegal font `"&CHR&"'"); F←0 END;
06900 IF F>0 AND FONTFIL[F]=0 THEN
07000 BEGIN
07100 IF XCRIBL THEN TES 11/5/73 ;
07200 WARN("=","Unknown font `"&CHR&"'");
07300 F←0;
07400 END;
07500 IF F AND XCRIBL THEN
07600 BEGIN
07700 EMIT(NULL);
07800 IF F NEQ THISFONT THEN APPEND(PICKFONT(F)) ;
07900 SWITCHFONT(F) ; TES 11/15/73 SUBROUTINIZED ;
08000 END;
08100 END;
08200 ie 25 ... ⊗ ; EMIT(BRC) ; comment PASS 3 control only, no action here ;
08300 ie 26 ... [ ; EMIT(BRC) ; comment just to be safe ;
08400 ie 27 ... & ; EMIT(BRC) comment just to be safe ;
08500 END ; COMMENT BY BRC ;
08600 END "SCAN TEXT" UNTIL DONE ;
08700 END "PROCESS " ;
00100 INTERNAL RECURSIVE BOOLEAN PROCEDURE TEXTLINE ;
00200 BEGIN
00300 PRELOAD!WITH 6, [8]0, 1, [2]0, 5, 0, 3, [4]4, [6]0, 4, 2, 4, 2, [2]0 ;
00400 OWN INTEGER ARRAY TEXTTYPE[-15:15] ;
00500 BOOLEAN IMITEXT ; INTEGER USYMB, LEN ; STRING STR ;
00600 IMITEXT ← TRUE ; comment assume computed text line ;
00700 CASE TEXTTYPE[THISTYPE] OF
00800 BEGIN COMMENT BY TYPE ;
00900 ie 0 ... Invalid ; RETURN(FALSE) ;
01000 ie 1 ... [ ; BEGIN comment [Est] Label or [@] rubout gen-label ; PASS ;
01100 IF ITS(@) THEN BEGIN PASS ; IMITEXT ← FALSE END
01200 ELSE BEGIN LEN ← CVD(E("5", 0)) ; COMMENT THANKS RKJ ;
01300 IF ITSCH("]") THEN PASS ELSE
01350 WARN("=","Missed ] after label length; You probably thought you had" & CRLF &
01375 "a subscripted variable like X[I] computing text;" & CRLF &
01387 "but the syntax of that would be (X[I]). See" & CRLF &
01393 "p.21 in the manual for parenthesis rules.") ;
01400 THISWD ← LABELREF(0, LEN) ; END ;
01500 END ;
01600 ie 2 ... Unit ; IF THATISID THEN
01700 BEGIN comment Unit Label ;
01800 USYMB ← SYMB ;
01900 LEN ← IF THISTYPE=PUNITTYPE THEN PATT!CHRS(IX) ELSE CTR!CHRS(IX) ;
02000 PASS ; THISWD ← LABELREF(USYMB, LEN) ;
02100 END
02200 ELSE IF IX=IXPAGE THEN
02300 BEGIN comment, Generate a label ;
02400 THISWD ← NULL ;
02500 THISWD ← LABELREF(0, IF ITS(PAGE) THEN CTR!CHRS(IXPAGE) ELSE PATT!CHRS(IXPAGE)) ;
02600 END
02700 ELSE THISWD ← VEVAL ;
02800 ie 3 ... Constant ;
02900 BEGIN
03000 LOPP(THISWD) ;
03100 IF THATISID ∧ SIMLOOK(CAPITALIZE(STR←SCAN(THISWD,ALPHA,DUMMY)))
03200 ∧ (SYMTYPE = UNITTYPE ∨ SYMTYPE = PUNITTYPE) THEN
03300 BEGIN comment "Unit.." Label ;
03400 IF SYMTYPE=PUNITTYPE THEN STR←STR[1 TO ∞-1]; USYMB ← SYMBOL;
03500 LEN ← IF SYMTYPE=PUNITTYPE THEN PATT!CHRS(SYMIX) ELSE CTR!CHRS(SYMIX) ;
03600 PASS ; THISWD ← STR & SP & LABELREF(USYMB, LEN) ;
03700 END ;
03800 END ;
03900 ie 4 ... Variable ; THISWD ← VEVAL ;
04000 ie 5 ... } etc. ; IF IX comment not } ; THEN RETURN(FALSE) ELSE IMITEXT←FALSE ;
04100 ie 6 ... misc ; IF ITSCH("(") THEN BEGIN PASS; STR←E(NULL,NULL);
04200 IF ¬ITSCH(")") THEN WARN("=","Parens don't match") ; THISWD←STR END ELSE RETURN(FALSE) ;
04300 END ; COMMENT BY TYPE ;
04400 IF IMITEXT THEN IF NULSTR(THISWD) OR ¬ON THEN ELSE
04500 BEGIN
04600 BEGINBLOCK(FALSE, 0, "!NAKED") ;
04700 SWICH(THISWD&ALTMODE&" END ""!NAKED""", -1, 0) ;
04800 PROCESS ;
04900 END
05000 ELSE PROCESS ;
05100 PASS ;
05200 RETURN(TRUE) ;
05300 END "TEXTLINE" ;
00100 END "INNER BLOCK" ;
00200 END "FILLER"